home *** CD-ROM | disk | FTP | other *** search
/ MacFormat 1995 August / macformat-027.iso / mac / Shareware City / Science / GesSpectreƒ / EffiCRC.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-07-27  |  2.0 KB  |  99 lines  |  [TEXT/TPAS]
  1. program crc;
  2.  
  3. uses Memtypes, Quickdraw, OsintF,ToolIntf,PackIntf,sane;
  4.  
  5.  
  6. type ElementType=record
  7.                    nom:string[10];
  8.                    DemiVie:extended;
  9.                    Ener:array[1..4] of record
  10.                                         E,G:extended;
  11.                                        end;
  12.                  end;
  13.                
  14. var T:text;
  15.     L:str255;
  16.     Fname:string;
  17.     
  18.     Table:array[1..70] of ElementType;
  19.     i,j,nMax:integer;
  20.     
  21. function getfname(var filename:String;mask:OSType):boolean;
  22. var posit:point;
  23.     oldname,prompt:Str255;
  24.     tlist:SFTypelist;
  25.     reponse:SFReply;
  26.     result:integer;
  27.     info:paramblockrec;
  28.     
  29.    
  30. begin
  31. getfname:=false;
  32. oldname:=filename;
  33. posit.v:=80;
  34. posit.h:=40;
  35. prompt:='';
  36. tlist[0]:=mask;
  37. flushevents(everyevent,0);
  38. sfgetfile(posit,prompt,nil,1,tlist,nil,reponse);
  39. with reponse do
  40.  if good then 
  41.    begin
  42.     filename:=fname;
  43.     result:=setvol(nil,Vrefnum);
  44.     good:= result=Noerr;
  45.     info.ioFdirindex:=0;
  46.     info.ioVrefNum:=Vrefnum;
  47.     info.ionamePtr:=@fname;
  48.     if PBgetFInfo(@info,false)<>noErr then halt;
  49.     end else filename:=oldname;
  50. getfname:=reponse.good;
  51. end;
  52.  
  53. begin
  54. Fname:='';
  55. if not GetFname(Fname,'TEXT') then halt;
  56. {$i-}
  57. reset(T,Fname);
  58. {$i+}
  59. if ioresult<>0 then halt;
  60. Nmax:=0;
  61. while not eof(T) do
  62.  begin
  63.  readln(T,L);
  64.  Nmax:=Nmax+1;
  65.  With Table[Nmax] do
  66.   begin
  67.    j:=Pos(#9,L);
  68.    nom:=copy(L,1,J-1);
  69.    delete(L,1,j);
  70.    j:=Pos(#9,L);
  71.    DemiVie:=str2Num(copy(L,1,J-1));
  72.        if Relation(Demivie, 0) = Unordered then DemiVie:=0;
  73.    delete(L,1,j);
  74.    for i:=1 to 4 do
  75.     begin
  76.      j:=Pos(#9,L);
  77.      Ener[i].E:=str2Num(copy(L,1,J-1));
  78.        if Relation(Ener[i].E, 0) = Unordered then Ener[i].E:=0;
  79.      delete(L,1,j);
  80.      j:=Pos(#9,L);
  81.      Ener[i].G:=str2Num(copy(L,1,J-1));
  82.          if Relation(Ener[i].G, 0) = Unordered then Ener[i].G:=0;
  83.      delete(L,1,j);
  84.     end;
  85.   end;
  86.  end;
  87. writeln('TABLE DE ',nmax,' NUCLEIDES');
  88. writeln;
  89. for i:=1 to Nmax do
  90.  with table[i] do 
  91.   begin
  92.   write(nom:8,DemiVie:12:2);
  93.   for j:=1 to 4 do write(Ener[j].E:8:0,Ener[j].G:6:2);
  94.   writeln;
  95.   end;
  96.  
  97. close(T);
  98. readln;
  99. end.